perm filename MPRNT.F4[MSS,LCS]6 blob
sn#134973 filedate 1974-12-09 generic text, type T, neo UTF8
00100 C MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
00200 C *** READS DATA FROM CLFX, TAIL, FERM, BREP, REST, DRAW1, DRAW2
00300 C LOAD WITH PPSRT, PLTCMD, NOTWRT, ITMSBX, TREST, CLFZ, LOOK
00400
00500 IMPLICIT INTEGER(A-Q,S-Z)
00600 REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS,BOT,TOP,TOP2
00700 COMMON /DL/IXRX,SAVER,NAME
00800 CC DIMENSION V(78),LIST(200)
00900 COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
00910 CC COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,J3EN,KCEN
01000 COMMON/ALF/INP(72),ML/XRN/RN(4000)/STF/RSTFAC(-3/4),RSTJ3
01100 COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,M
01200 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/POSI/STFF(-3/4),JJ2,POS
01300 COMMON/DPY/GO,TOP,BOT
01310 CC COMMON/DPY/GO,RXGP,TOP,BOT
01400 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01500 1,(R6,RJQ(4)),(J7,JQ(5)),(J6,JQ(4)),(R7,RJQ(5))
01600 1,(R4,RJQ(2)),(R3,RJQ(1)),(I1,INP(1))
01700 CC 1,(LIST,RN(3100)),(V,RN(3000))
01800 DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
01900 1 ,IP/'P'/
02000
02100 TOP2=-999
02200 NOMOVE=0
02300 I1=0
02400 C RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
02700 2 TOP=-999
02800 BOT=999
02900 20 PLT=0
02910 PLOTIT=0
03000 PWDS(1)=1.
03100 EDX=-1
03200 DO 1402 K=-3,4
03300 1402 RSTFAC(K)=1.
03400 M=1
03500 ITEM=0
03600 CC IXRX=0
03700 I=1
03800 CC58 GO=-1
03900 GO TO 5504
04000
04100
04200 11 CALL NOTWRT
04300 57 IF(PLT)GO TO 6120
04400 ITEM=ITEM+1
04500 IF(EDX.NE.-1.AND.M.LT.I)GO TO 6120
04600 IF(PLOTIT.EQ.-2)GO TO 2311
04700 CZZ PWDS(ITEM+1)=I
04800 CZZ PLT=0
04900 CC GO=-1
05000
05100 5504 IF(I1.EQ.IP)GO TO 2311
05200 CC59 TYPE 56
05300 CC ACCEPT 89,INP
05320 INP(1)='P'
05340 INP(2)='X'
05400 311 JA=0
05500 IF(I1.NE.IP)GO TO 85
05600 2311 CALL PLTCMD
05700 IF(PLOTIT.EQ.0)GO TO 3005
05800 I1=IP
05900 PLOTIT=-1
06000 C 'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
06100 CC89 FORMAT(72A1)
06200
06300 6531 M=1
06400 EDX=-1
06500 DO 5532 K=1,9
06600 5532 JQ(K)=RJQ(K)
06700 590 IF(PLOTIT.EQ.-1)GO TO 121
06800 I1=0
06900 243 R2=1.
07000 C TO RUN THROUGH DATA.
07100 CXX241 RSZ=.845*R2
07200 R2=0
07300 R3=0
07400 R4=0
07500 TOP=-999
07600 BOT=999
07700 C GOES TO PLOTTER
07800 85 M=1
07900 I=PWDS(ITEM+1)
08000 ITEM=0
08100 8852 PLT=1
08200 EDX=0
08300 CC GO=0
08400 GO TO 6120
08500
08600 60 IF(JA.NE.88)GO TO 601
08700 RSTFAC(J3)=R2
08800 C FOR STAFF SIZE FACTOR WITHOUT STAFF.
08900 GO TO 57
09000 CXX601 RSTJ3=RSTFAC(J3+4)
09050 601 RSTJ3=RSTFAC(J3)
09100 5541 POS=STFF(J3)
09200 J2=RHORZ(R2)
09300 C LINE IS DIVIDED INTO 200 POINTS.
09400 CALL CENTX
09434 C SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
09468 R2=J2
09502 IF(JA.LE.2)GO TO 11
09536 551 GO TO(11,11,68,25,69, 11,81,67,25,25, 68,67),JA
09570 IF(JA.EQ.16.OR.JA.EQ.20)GO TO 116
09604 IF(JA.EQ.18)GO TO 80
09808
09842 69 CALL MAKNUM(R6)
09876 GO TO 57
09910
09944 68 CALL CLEFS
09978 GO TO 57
10012
10046 67 CALL SLUR
10080 GO TO 57
10114
10148 116 CALL ALPHA
10182 GO TO 57
10216
10250 81 CALL KSIG
10284 GO TO 57
10318
10352 80 CALL METER
10386 GO TO 57
10420
10556 25 CALL ITMSUB
10590 C BAR LINES, BEAMS, STAFF LINES ****
10624 GO TO 57
11100
11200 3005 REWIND 21
11300 C GUARDS AGAINST LOSSAGE!
11400 PLOTIT=-2
11500 CALL IFILE(21,NAME)
11600 C JUMP TO READ BIG FILES
11700 2200 J=ITEM+1
11800 2202 READ(21),X,Y,(PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2)
11910 CC 1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
12000 CC 1 LCNT,(LIST(K),K=1,LCNT)
12100 CC READ(21),RSTFAC,STFF
12110 IF(Y.LE.2000)GO TO 3202
12120 TYPE 4202,Y
12130 STOP
12140 4202 FORMAT(' ***** TOO MUCH DATA ',I4,'/2000')
12200 3202 ITEM=ITEM+X
12300 I=Y
12400 GO TO 6531
12500 121 IF(PLOTIT.EQ.0)GO TO 5504
12600 5121 CALL PLTSRT
12700 C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
12800 PLT=-1
12900 C (J8) P8=1 OR 2 FOR 2-PASS PLOTS
13000 CC M=I
13100 CC I=I+M-1
13200 IF(R2.EQ.0)R2=1.
13300 DIS=R2*1.24
13400 CXX IF(R3.EQ.0)R3=R2
13500 RHT=R3*1.2
13600 C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
13700 BOT=-BOT*RHT
13710 CX IXGP=100+BOT
13800 IF(TOP2.EQ.-999)GO TO 8121
13900 BOT=BOT+TOP2
13950 CC IXGP=IXGP+TOP2
14000 GO TO 9121
14050 CC GO TO 9122
14100 8121 CALL PLOTS(K)
14200 CC RXGP=995.-BOT
14240 C FOR 3/4" BOTTOM MARGIN
14260 CX9122 BOT=0
14280 C THIS HAPPENS FIRST TIME ONLY.
14290 9121 IF(NOMOVE.GT.1)BOT=NOMOVE
14300 NOMOVE=R6+R7*202.*R3
14400 C R6=1 FOR NO MOVE AT END. R7=# OF INCHES TO MOVE FOR NEW STAFF 0.
14500 CC IXGP=J4
14600 C (J4) P4=1 FOR XGP OUTPUT
14700 CC IF(J5.NE.0)GO TO 1122
14720 IF(J5.NE.0)GO TO 6120
14800 CC IF(R4.NE.0)GO TO 6120
14900 CC IF(TOP2.NE.-999)RXGP=RXGP-BOT
15000 C MOVES 0 POINT OVER EACH TIME.
15100 CC GO TO 1122
15200 6121 CALL PLOT(0,IFIX(BOT),-3)
15300 C MOVES PLOTTER UP IF P5=0.
15400 CC1122 IXRX=IXGP
15500
15600 C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
15700 6120 IF(M.GE.I)GO TO 7120
15800 CNT=RN(M)
15900 DO 6220 K=CNT+1,10
16000 JQ(K)=0
16100 6220 RJQ(K)=0
16200 JA=RN(M+1)
16300 M=M+2
16400 R2=RN(M)
16500 DO 9120 K=1,CNT
16600 RJQ(K)=RN(M+K)
16700 9120 JQ(K)=RJQ(K)
16800 M=CNT+M+1
16900 CC IF(EDX.LE.0)GO TO 60
17000 CC GO TO 5504
17050 GO TO 60
17100
17200 7120 M=1
17300 CZ IF(EDX)GO TO 71201
17400 CZ IF(PLT.EQ.1)EDX=-1
17500 CZ PLT=0
17600 C RETURNS FOR 'SL'=SAVE LAST
17700 CZ GO TO 5504
17800 CC71201 X=50*RHT
17900 CC A=TOP*RHT+X
17950 71201 A=TOP*RHT+50.*RHT
18000 IF(NOMOVE.NE.0)A=0
18100 IF(NOMOVE.GT.1)A=NOMOVE
18200 CALL PLOT(0,IFIX(A),3)
18225 IF(NOMOVE.EQ.1)GO TO 20
18237 C PRESERVES TOP AND BOT IF NOMOVE
18250 CX CALL PLOT(0,TOP+IXGP,3)
18275 TOP=A
18300 TOP2=TOP
18400 GO TO 2
18500 C TO MOVE 'PLOTTER' FOR XGP OUTPUT
18600 C MOVES PLOTTER UP
18700 C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
18800
18900 CC56 FORMAT(' PXG OR PXC'/)
19000 END